home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / IMPEDCCT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-03-15  |  5.6 KB  |  196 lines
  1. 10  'IMPEDCCT - Reactance/Resistance Circuits - 08 MAR 97
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  CLS:KEY OFF
  4. 40  COLOR 7,0,1
  5. 50  U$="#####.####"
  6. 60  PI=3.14159
  7. 70  N=11 'number of arrays
  8. 80  DIM I(N),I$(N,2),FLAG(N)
  9. 90  RESTORE
  10. 100  DATA Frequency,MHz,Capacitance,pF,Capacitive Reactance,-,Inductance,>H
  11. 110  DATA Inductive Reactance,-,Resistance R- Series Circuit,-
  12. 120  DATA Impedance   - Series Circuit,-,Phase Angle - Series Circuit,<UNK! {00F8}>
  13. 130  DATA Resistance R- Parallel Circuit,-
  14. 140  DATA Impedance   - Parallel Circuit,-,Phase Angle - Parallel Circuit,<UNK! {00F8}>
  15. 150  FOR Z=1 TO N:READ I$(Z,1),I$(Z,2):NEXT Z
  16. 160  FOR Z=1 TO N:I$(Z,1)=I$(Z,1)+STRING$(35-LEN(I$(Z,1)),"."):NEXT Z
  17. 170  '
  18. 180  '.....start
  19. 190  FOR Z=1 TO N:I(Z)=O:NEXT Z      'clear array
  20. 200  COLOR 15,2
  21. 210  PRINT " IMPEDANCE - REACTANCE/RESISTANCE CIRCUITS";
  22. 220  PRINT TAB(57)"by George Murphy VE3ERP ";
  23. 230  COLOR 1,0:PRINT STRING$(80,223);
  24. 240  COLOR 7,0
  25. 250  GOSUB 1620
  26. 260  LOCATE 10
  27. 270  FOR Z=1 TO N:LOCATE ,20:PRINT I$(Z,1)
  28. 280  IF Z<12 THEN LOCATE CSRLIN-1,53-LEN(I$(Z,2)):PRINT "("+I$(Z,2)+")"
  29. 290  NEXT Z
  30. 300  PRINT
  31. 310  COLOR 0,7:LOCATE ,20:PRINT " Press 1 to continue or 0 to EXIT ";:COLOR 7,0
  32. 320  Z$=INKEY$:IF Z$=""THEN 320
  33. 330  IF Z$="0"THEN CLS:RUN EX$
  34. 340  IF Z$="1"THEN 370
  35. 350  GOTO 320
  36. 360  '
  37. 370  CLS:GOSUB 1500
  38. 380  PRINT:LN=CSRLIN
  39. 390  LOCATE LN
  40. 400  FOR Z=1 TO N:LOCATE ,20:PRINT I$(Z,1)
  41. 410  IF Z<12 THEN LOCATE CSRLIN-1,53-LEN(I$(Z,2)):PRINT "("+I$(Z,2)+")"
  42. 420  NEXT Z
  43. 430  K=6
  44. 440  LOCATE LN-1,50:PRINT STRING$(29,32):LOCATE LN-1
  45. 450  COLOR 14:PRINT " ENTER: "+I$(K,1)+" (0 if unknown)..."+"("+I$(K,2)+")";
  46. 460  INPUT I(K):COLOR 7
  47. 470  IF I(K)<>0 THEN 500
  48. 480  IF K=6 THEN K=9 ELSE IF K=9 THEN K=6
  49. 490  GOTO 440
  50. 500  LOCATE LN-1+K,56:PRINT USING U$;I(K)
  51. 510  FOR Z=1 TO N:LOCATE LN-1+Z,13:PRINT "< ";CHR$(Z+96);" >":NEXT Z
  52. 520  A$="SERIES":B$="PARALLEL"
  53. 530  IF K=6 THEN A=LN-1+9:B=LN-1+11
  54. 540  IF K=9 THEN A=LN-1+6:B=LN-1+8 :SWAP A$,B$
  55. 550  VIEW PRINT A TO B:CLS:VIEW PRINT
  56. 560  LOCATE LN-1:COLOR 14
  57. 570  PRINT " Press a letter in < > below to enter SOUGHT component...";
  58. 580  PRINT STRING$(20,32):COLOR 7
  59. 590  Z$=INKEY$:IF Z$=""THEN 590
  60. 600  Y=ASC(Z$)-96
  61. 610  IF Y<1 OR Y>N THEN 590
  62. 620  IF K=6 AND Y>=9 AND Y<=N  THEN 590
  63. 630  IF K=9 AND Y>=6 AND Y<=8  THEN 590
  64. 640  FLAG(Y)=1
  65. 650  LOCATE LN-1+Y,60:PRINT "SOUGHT"
  66. 660  FOR Z=LN TO 23:LOCATE Z:PRINT STRING$(17,32):NEXT Z
  67. 670  '
  68. 680  '.....input data
  69. 690  FOR Z=1 TO N:IF FLAG(Z)=1 THEN 770
  70. 700  IF I(Z)<>0 THEN 770
  71. 710  IF K=6 THEN IF Z>=9 AND Z<=N THEN 770
  72. 720  IF K=9 THEN IF Z>=6 AND Z<=9 THEN 770
  73. 730  COLOR 14
  74. 740  LOCATE LN-1:PRINT " ENTER: ";I$(Z,1);"( 0 if unknown )...(";I$(Z,2);")";
  75. 750  INPUT I(Z):COLOR 7
  76. 760  GOSUB 800
  77. 770  NEXT Z
  78. 780  GOTO 690
  79. 790  '
  80. 800  '.....calculate
  81. 810  IF I(Z)<>0 THEN LOCATE LN-1+Z,56:PRINT USING U$;I(Z)
  82. 820  LOCATE LN-1:PRINT STRING$(80,32);:LOCATE LN-1
  83. 830  F=I(1):C=I(2):XC=I(3):L=I(4):XL=I(5):RS=I(6):ZS=I(7)
  84. 840  AS=I(8)*PI/180:RP=I(9):ZP=I(10):AP=I(11)*PI/180
  85. 850  JJ=1/(4*PI^2)*10^6    'JJ=25330.29
  86. 860  '.....scan
  87. 870  IF XL=0 AND F*L<>0 THEN XL=2*PI*F*L:GOTO 860
  88. 880  IF L=0 AND F*XL<>0 THEN L=XL/(2*PI*F):GOTO 860
  89. 890  IF F=0 AND L*XL<>0 THEN F=XL/(2*PI*L):GOTO 860
  90. 900  '
  91. 910  IF XC=0 AND F*C<>0 THEN XC=1/(2*PI*F*C):GOTO 860
  92. 920  IF C=0 AND F*XC<>0 THEN C=1/(XC*2*PI*F):GOTO 860
  93. 930  IF F=0 AND C*XC<>0 THEN F=1/(2*PI*XC*C):GOTO 860
  94. 940  '
  95. 950  IF ZS=0 AND RS*XL<>0 THEN ZS=SQR(RS^2+XL^2):GOTO 860
  96. 960  IF ZS=0 AND RS*XC<>0 THEN ZS=SQR(RS^2+XC^2):GOTO 860
  97. 970  '
  98. 980  IF AS=0 AND ZS*XL*RS<>0 THEN AS=ATN(XL/RS):GOTO 860
  99. 990  IF AS=0 AND ZS*XC*RS<>0 THEN AS=-ATN(XC/RS):GOTO 860
  100. 1000  '
  101. 1010  IF ZP=0 AND RP*XL<>0 THEN ZP=RP*XL/SQR(RP^2+XL^2):GOTO 860
  102. 1020  IF ZP=0 AND RP*XC<>0 THEN ZP=RP*XC/SQR(RP^2+XC^2):GOTO 860
  103. 1030  '
  104. 1040  IF AP=0 AND ZP*XL*RP<>0 THEN AP=ATN(RP/XL):GOTO 860
  105. 1050  IF AP=0 AND ZP*XC*RP<>0 THEN AP=-ATN(RP/XC):GOTO 860
  106. 1060  '
  107. 1070  I(1)=F:I(2)=C:I(3)=XC:I(4)=L:I(5)=XL:I(6)=RS:I(7)=ZS
  108. 1080  I(8)=AS*180/PI:I(9)=RP:I(10)=ZP:I(11)=AP*180/PI
  109. 1090  IF I(Y)=0 THEN RETURN
  110. 1100  '
  111. 1110  '.....display values
  112. 1120  VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN
  113. 1130  XCC=INT(I(3)*10^4+0.5)/10^4
  114. 1140  XLL=INT(I(5)*10^4+0.5)/10^4
  115. 1150  IF I(3)<>0 THEN J$=" - j"+STR$(XCC):X=-I(3):GOTO 1180
  116. 1160  IF I(5)<>0 THEN J$=" + j"+STR$(XLL):X=I(5)
  117. 1170  '
  118. 1180  FOR Z=1 TO N
  119. 1190  PRINT TAB(20)I$(Z,1);USING U$;I(Z);
  120. 1200  IF Z=7 OR Z=10 THEN IF I(Z)<>0 THEN Y=I(Z):PRINT J$;
  121. 1210  IF I(Z)=0 THEN PRINT "" ELSE PRINT " "+I$(Z,2)
  122. 1220  IF I(Z)=0 THEN LOCATE CSRLIN-1,56:PRINT "    -    "
  123. 1230  NEXT Z
  124. 1240  PRINT TAB(20)"Admittance"+STRING$(25,".");USING U$;1/Y;:PRINT " siemens"
  125. 1250  PRINT :SWAP A$,B$:COLOR 0,7
  126. 1260  PRINT " Do you want to calculate the equivalent "; A$;" circuit?    (y/n) "
  127. 1270  COLOR 7,0
  128. 1280  Z$=INKEY$:IF Z$=""THEN 1280
  129. 1290  IF Z$="n"THEN LOCATE CSRLIN-1:PRINT STRING$(79,32):GOTO 1480
  130. 1300  IF Z$="y"THEN 1320
  131. 1310  GOTO 1280
  132. 1320  I(3)=0:I(5)=0
  133. 1330  IF A$="PARALLEL"THEN 1360
  134. 1340  IF A$="SERIES"THEN 1420
  135. 1350  '
  136. 1360  RP=(RS^2+X^2)/RS:I(9)=RP
  137. 1370  XP=(RS^2+X^2)/X
  138. 1380  IF XP<0 THEN I(3)=ABS(XP)ELSE I(5)=ABS(XP)
  139. 1390  I(6)=0:I(10)=I(7):I(7)=0:I(11)=I(8):I(8)=0
  140. 1400  GOTO 1470
  141. 1410  '
  142. 1420  RS=RP*X^2/(RP^2+X^2):I(6)=RS
  143. 1430  XS=RP^2*X/(RP^2+X^2)
  144. 1440  IF XS<0 THEN I(3)=ABS(XS)ELSE I(5)=ABS(XS)
  145. 1450  I(9)=0:I(7)=I(10):I(10)=0:I(8)=I(11):I(11)=0
  146. 1460  '
  147. 1470  GOTO 1110  'display
  148. 1480  GOTO 1780  'end
  149. 1490  '
  150. 1500  '.....diagram
  151. 1510  COLOR 0,7:T=22:LOCATE 1
  152. 1520  LOCATE ,T:PRINT "         RF CIRCUIT COMPONENTS         "
  153. 1530  LOCATE ,T:PRINT "     VARPTRSOUNDSOUNDSOUNDCOLOR                   VARPTRSOUNDSOUNDSOUNDCOLOR     "
  154. 1540  LOCATE ,T:PRINT "  VARPTRSOUNDSOUND<0xB4!> X BLOADSOUND\/\/\SOUNDCOLOR    VARPTRSOUNDSOUNDBSAVESOUNDSOUNDSOUND<0xB4!> X BLOADSOUNDSOUNDSOUNDCOLOR "
  155. 1550  LOCATE ,T:PRINT " SOUND'  CLSSOUNDSOUNDSOUND'   R   CALL   SOUND'  CALL   CLSSOUNDSOUNDSOUND'   CALL "
  156. 1560  LOCATE ,T:PRINT " Eac             CALL   Eac CLSSOUNDSOUNDSOUND\/\/\SOUNDSOUNDSOUND<0xB4!> "
  157. 1570  LOCATE ,T:PRINT " SOUNDCOLOR              CALL   SOUNDCOLOR        R     CALL "
  158. 1580  LOCATE ,T:PRINT "  CLSSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND'    CLSSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND' "
  159. 1590  LOCATE ,T:PRINT "   SERIES CIRCUIT     PARALLEL CIRCUIT "
  160. 1600  COLOR 7,0:RETURN
  161. 1610  '
  162. 1620  '.....prologue
  163. 1630  T=7
  164. 1640  PRINT TAB(T);
  165. 1650  PRINT "There are many interactive components in RF circuits. One common to"
  166. 1660  PRINT TAB(T);
  167. 1670  PRINT "most equations is the sum of all resistances associated with energy"
  168. 1680  PRINT TAB(T);
  169. 1690  PRINT "losses in the circuit, e.g., in capacitors, inductors, wire"
  170. 1700  PRINT TAB(T);
  171. 1710  PRINT "resistance, core losses and skin effect. Once this total resistance"
  172. 1720  PRINT TAB(T);
  173. 1730  PRINT "is known, values of other circuit factors shown in the list below"
  174. 1740  PRINT TAB(T);
  175. 1750  PRINT "can be computed quickly with this program."
  176. 1760  RETURN
  177. 1770  '
  178. 1780  '.....end
  179. 1790  GOSUB 1820:CLS:GOTO 180
  180. 1800  END
  181. 1810  '
  182. 1820  'HARDCOPY
  183. 1830  GOSUB 1940:LOCATE 25,2:COLOR 14,6
  184. 1840  PRINT " Press 1 to print screen, 2 to print screen & ";
  185. 1850  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  186. 1860  Z$=INKEY$:IF Z$="3"THEN GOSUB 1940:RETURN
  187. 1870  IF Z$="1"OR Z$="2"THEN GOSUB 1940:GOTO 1890
  188. 1880  GOTO 1860
  189. 1890  FOR QX=1 TO 24:FOR QY=1 TO 80
  190. 1900  LPRINT CHR$(SCREEN(QX,QY));
  191. 1910  NEXT QY:NEXT QX
  192. 1920  IF Z$="2"THEN LPRINT CHR$(12)
  193. 1930  GOTO 1830
  194. 1940  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  195. 1950  VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN
  196.